home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / quikcmd3.zip / BOOM.LSP < prev    next >
Lisp/Scheme  |  1992-07-05  |  6KB  |  171 lines
  1. ;  BOOM.LSP
  2.  ;
  3.  ;                         QUICK COMMAND Release 3.0
  4.  ;                   BOOM.LSP is a module of QUICK COMMAND
  5. ;                      Copyright 1989, 90, 92 Dan Jincks
  6.  ;
  7.  ;
  8. ;              This is SHAREWARE, it is NOT Public Domain software.
  9.  ;
  10.  ;              This code or any part of this code may not be reproduced
  11.  ;              in any publication without prior written permission.
  12.  ;
  13.  ;              Printed copy of this code or any part of this code may not
  14.  ;              be distributed without prior written permission.
  15.  ;
  16.  ;              Printed copy may only be made for reference purposes by
  17.  ;              the end user.
  18.  ;
  19.  ;
  20.  ;                               Dan Jincks
  21.  ;                             Box 155A HCR 77
  22.  ;                           Annapolis, MO 63620
  23.  ;
  24.  ;
  25.  ;
  26.  ;   You are granted a limited license to use BOOM.LSP for a 30 day trial
  27.  ;   period.  If you wish to continue using any or all of QUICK COMMAND after
  28.  ;   the trial period, you must become a registered user.  As a registered
  29.  ;   user, you may use QUICK COMMAND on 1 workstation or terminal.
  30.  ;   Additional registrations must be bought for each additional workstation or
  31.  ;   terminal.  To become a registered user, see QC3.DOC
  32.  ;
  33.  ;
  34.  ;   You may send copies of QUICK COMMAND to friends and associates if you abide
  35.  ;   by the following rules:
  36.  ;
  37.  ;   1. It may only be distributed in the original unmodified form.
  38.  ;   2. All original files must be included.
  39.  ;   3. No addition files may be added.
  40.  ;   4. If other files will be on the same disk, QUICK COMMAND files must be in
  41.  ;      a library format such as ".ARC" called "QUICKCMD", or else be put alone
  42.  ;      in a subdirectory called "QUICKCMD".
  43.  ;   5. You may not sell QUICK COMMAND or any part of it.
  44.  ;   6. You are not allowed to charge more then $5 to cover the cost of copying
  45.  ;      and distribution.
  46.  ;   7. You may not distribute any hard copy of the contents of QUICK COMMAND.
  47.  ;
  48.  ;
  49.  ;   These AutoLISP commands and functions are designed to save you time, and
  50.  ;   saving time means saving money.  The registration fee is very modest
  51.  ;   compared to the savings, and much less expensive then typical third party
  52.  ;   AutoCAD software. Be sure to registar if you continue to use them.
  53.  ;
  54.  ;
  55.  ;                                                               DAN
  56.  ;
  57.  ;
  58.  ;
  59.  ;
  60.  ;        AutoCAD and AutoLISP are registered trade marks of Autodesk Inc.
  61.  ;
  62.  ;        ***************************************************************
  63.  ;
  64.  ;   Begin BOOM.LSP
  65.  ;
  66. ; BOOM function
  67.  ;
  68. (defun C:BOOM (/ SCA SCB SCC SCD SCE SCF SCH SCI SCJ SCN SCX SCY SCZ SSA SSB
  69.                  SCK SCG SCK SSC SSD SC1 SC2 SCBX SCPX SCMX SCDX)(TERPRI)
  70.    (prompt " Explode Blocks, Plines, 3D Meshes, Dimensions within a window.")
  71.    (terpri)
  72.    (prompt " An UNDO MARK has been placed")
  73.    (terpri)
  74.    (setvar "cmdecho" 0)
  75.    (command "UNDO" "MARK")
  76.    (setq SC1 (getpoint "First corner of window"))(terpri)
  77.    (setq SC2 (getcorner SC1 "Second corner"))(terpri)
  78.    (setq SCBX nil SCPX nil SCMX nil SCDX nil SCN nil SCF 0 SCI 0 SCH 0 SCG 0)
  79.    (setq SSB (ssadd))(setq SSD (ssadd))
  80.    (initget "Yes No")
  81.    (setq SCBX (getkword "Explode Blocks? Y/N <Yes> "))(terpri)
  82.    (initget "Yes No")
  83.    (setq SCPX (getkword "Explode Polylines Y/N <Yes> "))(terpri)
  84.    (initget "Yes No")
  85.    (setq SCMX (getkword "Explode 3D Meshes? Y/N <Yes> "))(terpri)
  86.    (initget "Yes No")
  87.    (setq SCDX (getkword "Explode Dimensions? Y/N <Yes> "))(terpri)
  88.    (if (/= SCBX "No")(progn
  89.       (initget "Yes No")
  90.       (setq SCN (getkword "Explode nested blocks? Y/N <Yes> "))(terpri)
  91.       (if (/= SCN "No")(setq SCK 2)(setq SCK 1))
  92.       (grclear)
  93.       (prompt " Exploding blocks. ")(terpri)
  94.        (while (/= SCG SCK)
  95.          (setq SSA (ssget "W" SC1 SC2))
  96.          (setq SCA 0)
  97.          (setq SCE (ssname SSA SCA))
  98.          (while (/= SCE nil)
  99.             (setq SCB (entget SCE))
  100.             (setq SCD (cdr (assoc 0 SCB)))
  101.             (setq SCX (cdr (assoc 41 SCB)))
  102.             (setq SCY (cdr (assoc 42 SCB)))
  103.             (setq SCZ (cdr (assoc 43 SCB)))
  104.             (if (= SCD "INSERT")(progn
  105.                (if (= SCX SCY SCZ)
  106.                (progn
  107.                   (command "EXPLODE" SCE)
  108.                      (if (/= SCN "No")(progn
  109.                        (setq SCC (entlast))
  110.                        (ssadd SCC SSA)
  111.                      ))
  112.                )
  113.                (progn
  114.                   (ssadd SCE SSB)
  115.                   (if (= SCK 1)(setq SCI (1+ SCI))(setq SCI (+ 0.5 SCI)))
  116.                )
  117.                )
  118.             ))
  119.             (setq SCA (1+ SCA))
  120.             (setq SCE (ssname SSA SCA))
  121.          )
  122.        (setq SCG (1+ SCG))
  123.        )
  124.       )(grclear)
  125.    )
  126.    (if (or (/= SCPX "No")(/= SCDX "No")(/= SCMX "No"))(progn
  127.       (setq SSC (ssget "W" SC1 SC2))
  128.       (setq SCA 0)
  129.       (setq SCE (ssname SSC SCA))
  130.       (prompt " Exploding --   ")
  131.       (if (/= SCPX "No")(prompt "Plines   "))
  132.       (if (/= SCDX "No")(prompt "Dimensions   "))
  133.       (if (/= SCMX "No")(prompt "3D Meshes   "))
  134.       (terpri)
  135.       (while (/= SCE nil)
  136.          (setq SCB (entget SCE))
  137.          (setq SCD (cdr (assoc 0 SCB)))
  138.          (setq SCJ (cdr (assoc 71 SCB)))
  139.          (if (= SCD "INSERT")(progn
  140.              (setq SCH 1)
  141.              (ssadd SCE SSD)
  142.          ))
  143.          (if (or (and (= SCJ 0)(/= SCPX "No")(= SCD "POLYLINE"))
  144.                  (and (/= SCDX "No")(= SCD "DIMENSION"))
  145.                  (and (> SCJ 0)(/= SCMX "No")(= SCD "POLYLINE")))
  146.             (command "EXPLODE" SCE)
  147.          )
  148.          (setq SCA (1+ SCA))
  149.          (setq SCE (ssname SSC SCA))
  150.       )
  151.    ))
  152.    (setq SCI (fix SCI))
  153.    (if (/= SCI 0)(progn (princ SCI)
  154.       (prompt "  BLOCKS WITH UNEQUAL X Y Z SCALE COULD NOT BE EXPLODED")(terpri)
  155.       (prompt "  Rejected Blocks are highlighted. PRESS ENTER ")(terpri)
  156.       (command "SELECT" SSB pause)
  157.    ))
  158.    (prompt "Area has been Exploded.")
  159.    (if (= SCH 1)(progn
  160.      (prompt "  Unexploded blocks are highlighted. PRESS ENTER.")
  161.      (command "SELECT" SSD pause)
  162.    ))
  163.    (terpri)
  164.    (prompt "Exploded objects are displayed.  PRESS ENTER    ")
  165.    (command "LIST" pause "REDRAW")
  166.    (prompt "Use UNDO BACK to restore drawing.")
  167.    (setvar "cmdecho" 1)(princ)
  168. )
  169.  ;
  170.  ;  End Boom
  171.